Gold Medal Software 1/Gold Medal Software Volume 1 (Gold Medal) (1994).iso/prog/tpwprog6.arj/COMBO.PAS

Pascal/Delphi Source File | 1992-07-02 | 5.2 KB | 206 lines

{ combo.pas -- Interactive combo box dialogs }

program Combo;

{$R combo.res}

uses WinTypes, WinProcs, WObjects, Strings;

const

  id_Menu     = 100;    { Menu resource ID }
  cm_Dialog   = 101;    { Dialog-command ID }
  id_Dialog   = 200;    { Dialog resource ID }

  id_Simple   = 101;    { Simple combo ID }
  id_DropDown = 102;    { Drop-down combo ID }
  id_DDList   = 103;    { Drop-down-list combo ID }

  numCountries = 8;
  Countries: array[0 .. numCountries - 1] of PChar = (
    'Great Britain',
    'France',
    'Germany',
    'Sweden',
    'United States',
    'Mexico',
    'Canada',
    'Australia'
  );

  numStates = 13;
  States: Array[0 .. numStates - 1] of PChar = (
    'Arkansas',
    'Ohio',
    'Virginia',
    'Maryland',
    'Nevada',
    'Montana',
    'Pennsylvania',
    'California',
    'Florida',
    'Georgia',
    'Arizona',
    'Texas',
    'New Hampshire'
  );

  numCities = 8;
  Cities: Array[0 .. numCities - 1] of PChar = (
    'Philadelphia',
    'Peterborough',
    'Baltimore',
    'Phoenix',
    'San Antonio',
    'Key West',
    'San Francisco',
    'Atlanta'
  );

type

  PComboDialog = ^ComboDialog;
  ComboDialog = object(TDialog)
    procedure SetupWindow; virtual;
    procedure Ok(var Msg: TMessage);
      virtual id_First + id_Ok;
  end;

  ComboApplication = object(TApplication)
    procedure InitMainWindow; virtual;
  end;

  PComboWindow = ^ComboWindow;
  ComboWindow = object(TWindow)
    constructor Init(AParent: PWindowsObject; ATitle: PChar);
    procedure CMDialog(var Msg: TMessage);
      virtual cm_First + cm_Dialog;
  end;


{ Common routines }

{- Add string addressed by P to combo box identified by CtrlID }
procedure SetCombo(HDlg: HWnd; CtrlID: Word; P: PChar);
begin
  SendDlgItemMessage(HDlg, CtrlID, cb_AddString, 0, LongInt(P))
end;

{- Retrieve selected string (if any), allocating a buffer on the
global heap, and returning in P the address of that buffer. If no
string is selected or an error occurs, P is set to nil. If P is
not nil, then Len equals the length in bytes of the allocated
buffer, including room for a null terminator. After using GetCombo,
if P is not nil, call FreeMem(P, Len) to dispose of the buffer. }

procedure GetCombo(HDlg: HWnd; CtrlID: Word; var P: PChar;
  var Len: Word);
var
  Index: Integer;
  HControl: HWnd;
begin
  P := nil;  { Default value in case of any errors }
  HControl := GetDlgItem(HDlg, CtrlID);
  Index := SendMessage(HControl, cb_GetCurSel, 0, 0);
  if Index <> cb_Err then
  begin
    Len := SendMessage(HControl, cb_GetLbTextLen, Index, 0);
    if Len > 0 then
    begin
      GetMem(P, Len + 1);  { Add 1 byte for null terminator }
      if P <> nil then
        SendMessage(HControl, cb_GetLbText, Index, LongInt(P))
    end
  end
end;


{ ComboDialog }

{- Prepare the dialog window's contents }
procedure ComboDialog.SetupWindow;
var
  I: Integer;
begin
  TDialog.SetupWindow;
  for I := 0 to numCountries - 1 do
    SetCombo(HWindow, id_Simple, Countries[I]);
  for I := 0 to numStates - 1 do
    SetCombo(HWindow, id_DropDown, States[I]);
  for I := 0 to numCities - 1 do
    SetCombo(HWindow, id_DDList, Cities[I])
end;

{- Respond to Ok button }
procedure ComboDialog.Ok(var Msg: TMessage);
var
  S1, S2, S3: PChar;          { Pointers to combo-box selections }
  L1, L2, L3: Word;           { Length in bytes of S1..S3 arrays }
  S4: Array[0 .. 64] of Char; { Holds concatenated selections }
begin
{- Initialize S4 to a null string }
  S4[0] := Chr(0);

{- Get combo listbox selections, if any }
  GetCombo(HWindow, id_Simple, S1, L1);
  GetCombo(HWindow, id_DropDown, S2, L2);
  GetCombo(HWindow, id_DDList, S3, L3);

{- Build result string in S4, ignoring nil pointers }
  if S1 <> nil then StrCat(S4, S1);
  StrCat(S4, ', ');
  if S2 <> nil then StrCat(S4, S2);
  StrCat(S4, ', ');
  if S3 <> nil then StrCat(S4, S3);

{- Dispose the temporary strings if not nil }
  if S1 <> nil then FreeMem(S1, L1);
  if S2 <> nil then FreeMem(S2, L2);
  if S3 <> nil then FreeMem(S3, L3);

{- Display selections, then continue dialog processing }
  MessageBox(HWindow, S4, 'Your selections are...', mb_Ok);
  TDialog.Ok(Msg)
end;

{ ComboApplication }

{- Initialize ComboApplication object's window }
procedure ComboApplication.InitMainWindow;
begin
  MainWindow := New(PComboWindow, Init(nil, 'Combo'))
end;


{ ComboWindow }

{- Construct ComboWindow object }
constructor ComboWindow.Init(AParent: PWindowsObject; ATitle: PChar);
begin
  TWindow.Init(AParent, ATitle);
  Attr.Menu := LoadMenu(HInstance, PChar(id_Menu));
end;

{- Execute Menu:Dialog command }
procedure ComboWindow.CMDialog(var Msg: TMessage);
begin
  Application^.ExecDialog(New(PComboDialog,
    Init(@Self, PChar(id_Dialog))))
end;

var

  ComboApp: ComboApplication;

begin
  ComboApp.Init('ComboApp');
  ComboApp.Run;
  ComboApp.Done
end.


{--------------------------------------------------------------
  Copyright (c) 1991 by Tom Swan. All rights reserved.
  Revision 1.00    Date: 3/28/1991
---------------------------------------------------------------}